Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE08/DATADICT/MYSTRNG.PAS

Pascal/Delphi Source File | 1996-02-01 | 12.8 KB | 433 lines

UNIT mystrng;{had to change name from strings...}
INTERFACE

CONST
  comma                    = ',';
  space                    = ' ';
  quote                    = '"';
  period                   = '.';
  cr                       = CHR(13);
  lf                       = CHR(10);
  tab                      = CHR(9);
  ff                       = CHR(12);
  bs                       = CHR(8);
  ctlz                     = CHR(26);
  numerics                 : SET OF CHAR = ['0'..'9'];
  signed                   : set of char = ['-','+'];
  science                  : SET OF CHAR = ['e', 'E'];
  percts                   : SET OF CHAR = ['%'];
  alpha                    : SET OF CHAR = ['a'..'z', 'A'..'Z'];
  crlf                     : SET OF CHAR = [cr, lf];
  ok_ctl                   : SET OF CHAR = [cr, lf, tab, ff, bs];
  printables               : SET OF CHAR = [' '..'~'];
  punctuation              : SET OF CHAR = [' '..'/', ':'..'@', '['..'`', '{'..'}'];

TYPE
  charset                  = SET OF CHAR;
  string132                = STRING[132];
  string80                 = STRING[80];
  string40                 = STRING[40];
  string20                 = STRING[16];
  string10                 = STRING[10];
  string8                  = STRING[8];
  string5                  = STRING[5];
  string2                  = STRING[2];

VAR
  scientific,
  percent,
  delete_percent           : BOOLEAN;

FUNCTION get_word(wrkstr : STRING; nth_word : BYTE) : STRING;

FUNCTION trim(workstr : STRING) : STRING;

FUNCTION right(in_string : STRING; size : BYTE; pad : CHAR) : STRING;

FUNCTION left(in_string : STRING; size : BYTE; pad : CHAR) : STRING;

FUNCTION center(in_string : STRING; size : BYTE; pad : CHAR) : STRING;

FUNCTION get_word_upto(wrkstr : STRING; delim : CHAR) : STRING;

FUNCTION get_words_from(wrkstr : STRING; delim : CHAR) : STRING;

FUNCTION upper(some_word : string) : string;

PROCEDURE parse(workstring               : STRING;
                VAR first_word,
                remainder                : STRING);

FUNCTION copies(num : INTEGER; wrkstr : STRING) : STRING;

FUNCTION find_next_char_position(of_these_char : charset; workline : STRING; start : BYTE) : BYTE;

FUNCTION next_symbol(workline : STRING; VAR ndx : BYTE) : STRING;

FUNCTION occurs(symbol : STRING; looking_for : charset) : INTEGER;

FUNCTION is_number(VAR symbol               : STRING;
                   uses_exp                 : BOOLEAN;
                   uses_percents            : BOOLEAN;
                   delete_percents          : BOOLEAN) : BOOLEAN;

FUNCTION parse_section(start, finish : BYTE; workline : STRING) : STRING;

{conversion routines numbers to string and vice versa}

function CommaDelimstrToInt(const s: string): longint;


FUNCTION real_str(real_value : REAL; exponential : BOOLEAN;
                  field_width, decimal_width : INTEGER) : string80;

FUNCTION boostr(boolean_value : BOOLEAN) : string5;

FUNCTION int_str(integer_value, field_width : INTEGER) : string10;

FUNCTION search_back_for(somestr : STRING; start_point : BYTE; target :char):byte;


IMPLEMENTATION
USES sysutils;
CONST
  copyright                = 'Copyright 1989, 1995 by Brandon C. Smith.';
  address                  = 'RR 2, Box 229-5, Mansfield, MO  65704';
  phone                    = '(417)-924-8021';
  email                    = '[e-mail]';
  version                  = 1.04;
{890401 .01 bcs incorporates find_next_char, next_symbol, occurs, parse_section
                and a slew of character constants.}
{890527 .02 bcs Changed get_word to recognize #13 as the end of string and not
                include it.}
{890709 .03 bcs added draw_box_str}
{890723 .04 bcs added search_back_for}
{951123 .05 bcs moved to Delphi wrklib}

  function CommaDelimstrToInt(const s: string): longint;
  var i : integer;
      tmpstr : string;
  begin
    tmpstr := '';
    for i := 1 to length(s) do
      if s[i] in numerics
        then tmpstr := tmpstr + s[i];
    if tmpstr = ''
      then tmpstr := '0';
    result := StrToInt(tmpstr);
  end;



FUNCTION search_back_for(somestr : STRING; start_point : BYTE; target :char):byte;
VAR
 i : BYTE;
 ch : CHAR;
BEGIN
  i := start_point;
  REPEAT
    ch := somestr[i];
    DEC(i);
  UNTIL (ch = ' ') OR (i = 0);
  search_back_for := i+1;
END;


  FUNCTION trim(workstr : STRING) : STRING;
  VAR first_char, last_char : INTEGER;
    done                     : BOOLEAN;
  BEGIN
    done := FALSE;
    first_char := 1;
    REPEAT
      IF workstr[first_char] <> ' ' THEN done := TRUE
      ELSE INC(first_char);
    UNTIL done OR (first_char = LENGTH(workstr));
    done := FALSE;
    last_char := LENGTH(workstr);
    REPEAT
      IF workstr[last_char] <> ' ' THEN done := TRUE
      ELSE DEC(last_char);
    UNTIL done OR (last_char = 1);
    trim := COPY(workstr, first_char, last_char - first_char + 1);
  END;

  FUNCTION get_word(wrkstr : STRING; nth_word : BYTE) : STRING;
  VAR i, ndx, start_pt, end_pt : BYTE;
    found                    : BOOLEAN;
  BEGIN
    IF LENGTH(wrkstr) = 0
      THEN BEGIN
        get_word := '';
        EXIT;
        END;
    ndx := 1;
    FOR i := 1 TO nth_word DO
    BEGIN
      found := FALSE;
      REPEAT                      { find first non blank }
        IF wrkstr[ndx] = ' '
          THEN INC(ndx)
          ELSE BEGIN
            start_pt := ndx;
            found := TRUE;
            END;
      UNTIL found;
      found := FALSE;
      REPEAT                      { find end of this word }
        IF (ndx > LENGTH(wrkstr)) OR (wrkstr[ndx] = ' ') or (wrkstr[ndx] = #13)
          THEN BEGIN
            end_pt := ndx - 1;
            found := TRUE;
            END
          ELSE INC(ndx);
      UNTIL found;
    END;
    get_word := COPY(wrkstr, start_pt, end_pt - start_pt + 1);
  END;

  FUNCTION get_word_upto(wrkstr : STRING; delim : CHAR) : STRING;
  VAR i                    : INTEGER;
    found                    : BOOLEAN;
  BEGIN
    found := FALSE;
    i := 1;
    REPEAT
      INC(i);
      IF wrkstr[i] = delim THEN found := TRUE;
      IF i > LENGTH(wrkstr) THEN found := TRUE;
    UNTIL found;
    get_word_upto := COPY(wrkstr, 1, i - 1);
  END;

  FUNCTION get_words_from(wrkstr : STRING; delim : CHAR) : STRING;
  VAR i                    : INTEGER;
    found                    : BOOLEAN;
  BEGIN
    found := FALSE;
    i := 0;
    REPEAT
      INC(i);
      IF wrkstr[i] = delim THEN found := TRUE;
      IF i > LENGTH(wrkstr) THEN found := TRUE;
    UNTIL found;
    IF i > LENGTH(wrkstr) THEN get_words_from := ''
    ELSE get_words_from := COPY(wrkstr, i + 1, 80);
  END;

  FUNCTION left(in_string : STRING; size : BYTE; pad : CHAR) : STRING;
  VAR i                    : INTEGER;
  VAR wrkstr               : STRING;
  BEGIN
    wrkstr := COPY(trim(in_string), 1, size);
    IF LENGTH(wrkstr) < size
    THEN
    BEGIN
      FOR i := LENGTH(wrkstr) TO size - 1 DO
        wrkstr := wrkstr + pad
    END;
    left := wrkstr;
  END;


  FUNCTION right(in_string : STRING; size : BYTE; pad : CHAR) : STRING;
  VAR i                    : INTEGER;
  VAR wrkstr               : STRING;
  BEGIN
    i := LENGTH(trim(in_string)) - size + 1;
    IF i <= 0 THEN wrkstr := COPY(trim(in_string), 1, size)
    ELSE wrkstr := COPY(trim(in_string), i, size);
    IF LENGTH(wrkstr) < size
    THEN
    BEGIN
      FOR i := 1 TO (size - LENGTH(wrkstr)) DO
        wrkstr := pad + wrkstr
    END;
    right := wrkstr;
  END;

  FUNCTION copies(num : INTEGER; wrkstr : STRING) : STRING;
  VAR i                    : INTEGER;
    tempstr                  : STRING;
  BEGIN
    tempstr := '';
    FOR i := 1 TO num DO
    BEGIN
      tempstr := tempstr + wrkstr;
    END;
    copies := tempstr;
  END;

  FUNCTION center(in_string : STRING; size : BYTE; pad : CHAR) : STRING;
  VAR i                    : INTEGER;
    wrkstr                   : STRING;
  BEGIN
    wrkstr := copies(size, ' ');
    i := (size DIV 2) - (LENGTH(trim(in_string)) DIV 2);
    IF i <= 0 THEN INSERT(trim(in_string), wrkstr, 1)
    ELSE INSERT(trim(in_string), wrkstr, i);
    center := COPY(wrkstr, 1, size);
  END;

  FUNCTION upper(some_word : string) : string;
  VAR i : INTEGER;
  BEGIN
    result := '';
    FOR i := 1 TO LENGTH(some_word) DO
        result := result + UPCASE(some_word[i]);
  END;


  PROCEDURE parse(workstring               : STRING;
                  VAR first_word,
                  remainder                : STRING);
  BEGIN
    workstring := trim(workstring);
    first_word := get_word(workstring, 1);
    remainder := trim(COPY(workstring, LENGTH(first_word) + 1, 255));
  END;

  FUNCTION find_next_char_position(of_these_char : charset; workline : STRING; start : BYTE) : BYTE;
  LABEL leave;
  VAR
    i                        : INTEGER;
    ch                       : CHAR;
  BEGIN
    FOR i := start TO LENGTH(workline) DO
    BEGIN
      ch := workline[i];
      IF ch IN of_these_char THEN GOTO leave;
    END;
leave:
    find_next_char_position := i;
  END;

  FUNCTION next_symbol(workline : STRING; VAR ndx : BYTE) : STRING;
  LABEL leave;
  VAR
    i,
    start_symbol,
    end_symbol               : BYTE;
    symbol                   : STRING;
  BEGIN
    symbol := '';
    IF (LENGTH(workline) = 0)
    OR (ndx > LENGTH(workline))
    OR (ndx <= 0)
    THEN
    BEGIN
      next_symbol := '';
      ndx := 0;
      GOTO leave;
    END;
    start_symbol := find_next_char_position(printables - [space, comma], workline, ndx);
    end_symbol := find_next_char_position([space, comma], workline, start_symbol);
    IF end_symbol = LENGTH(workline)
    THEN symbol := COPY(workline, start_symbol, end_symbol - start_symbol + 1)
    ELSE symbol := COPY(workline, start_symbol, end_symbol - start_symbol);
    FOR i := 1 TO LENGTH(symbol) DO
      IF symbol[i] = quote THEN symbol[i] := '''';
    next_symbol := symbol;
    IF ndx = LENGTH(workline)
    THEN ndx := 0
    ELSE ndx := end_symbol;
leave:
  END;

  FUNCTION occurs(symbol : STRING; looking_for : charset) : INTEGER;
  VAR
    i                        : INTEGER;
    count                    : INTEGER;
  BEGIN
    count := 0;
    FOR i := 1 TO LENGTH(symbol) DO
      IF symbol[i] IN looking_for THEN INC(count);
    occurs := count;
  END;

  FUNCTION is_number(VAR symbol               : STRING;
                     uses_exp                 : BOOLEAN;
                     uses_percents            : BOOLEAN;
                     delete_percents          : BOOLEAN) : BOOLEAN;
  LABEL leave;
  VAR
    i                        : INTEGER;
    is_num                   : BOOLEAN;
    check_char               : SET OF CHAR;
  BEGIN
    is_num := FALSE;
    check_char := numerics;
    IF uses_exp THEN check_char := numerics + science;
    IF uses_percents THEN check_char := numerics + percts;
    IF uses_exp AND uses_percents THEN check_char := numerics + science + percts;
    FOR i := 1 TO LENGTH(symbol) DO
      IF symbol[i] IN check_char
      THEN is_num := TRUE
      ELSE
      BEGIN
        is_num := FALSE;
        GOTO leave;
      END;
    IF uses_exp AND (occurs(symbol, science) > 1) THEN is_num := FALSE;
leave:
    is_number := is_num;
    IF delete_percents AND is_num
    THEN DELETE(symbol, POS('%', symbol), 1);
  END;

  FUNCTION parse_section(start, finish : BYTE; workline : STRING) : STRING;
  LABEL leave;
  VAR
    ndx                      : BYTE;
    symbol,
    section                  : STRING;
  BEGIN
    section := '';
    IF workline = '' THEN GOTO leave;
    ndx := start;
    REPEAT
      symbol := next_symbol(workline, ndx);
      IF is_number(symbol, scientific, percent, delete_percent)
      THEN section := section + symbol + comma
      ELSE
      BEGIN
        IF trim(symbol) <> ''
        THEN section := section + quote + symbol + quote + comma;
      END;
    UNTIL (ndx = 0) OR (ndx = LENGTH(workline)) OR (ndx >= finish) OR (trim(symbol) = '');
leave:
    parse_section := section;
  END;



  FUNCTION real_str(real_value : REAL; exponential : BOOLEAN;
                    field_width, decimal_width : INTEGER) : string80;
  VAR
    dummy                    : string80;
  BEGIN
    IF exponential THEN STR(real_value:field_width, dummy)
    ELSE STR(real_value:field_width:decimal_width, dummy);
    real_str := dummy;
  END;

  FUNCTION boostr(boolean_value : BOOLEAN) : string5;
  BEGIN
    IF boolean_value THEN boostr := 'True'
    ELSE boostr := 'False';
  END;

  FUNCTION int_str(integer_value, field_width : INTEGER) : string10;
  VAR
    dummy                    : string10;
  BEGIN
    STR(integer_value:field_width, dummy);
    int_str := dummy;
  END;




END.